Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/peacoc/sampldll.frm

Visual Basic Form | 1994-10-19 | 10.4 KB | 333 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Color By Name"
   ClientHeight    =   4425
   ClientLeft      =   1440
   ClientTop       =   1980
   ClientWidth     =   5655
   Height          =   5115
   Icon            =   SAMPLDLL.FRX:0000
   Left            =   1380
   LinkTopic       =   "Form1"
   ScaleHeight     =   4425
   ScaleWidth      =   5655
   Top             =   1350
   Width           =   5775
   Begin ListBox List2
      Height          =   3930
      Left            =   2955
      TabIndex        =   1
      Top             =   300
      Width           =   2520
   End
   Begin ListBox List1
      BackColor       =   &H00FFFFFF&
      Height          =   3930
      Left            =   165
      TabIndex        =   0
      Top             =   285
      Width           =   2520
   End
   Begin CommonDialog CMDialog
      Left            =   2535
      Top             =   3525
   End
   Begin Label Label2
      Caption         =   "User Defined Colors"
      Height          =   255
      Left            =   2955
      TabIndex        =   3
      Top             =   45
      Width           =   2085
   End
   Begin Label Label1
      Caption         =   "Predefined Colors"
      Height          =   255
      Left            =   210
      TabIndex        =   2
      Top             =   45
      Width           =   2085
   End
   Begin Menu M_FILE
      Caption         =   "&File"
      Begin Menu M_EXIT
         Caption         =   "E&xit"
      End
   End
   Begin Menu M_EDIT
      Caption         =   "&Edit"
      Begin Menu M_ADD_COLOR
         Caption         =   "&Add Color"
      End
      Begin Menu M_CHANGE
         Caption         =   "&Change Color"
      End
      Begin Menu M_DELETE
         Caption         =   "&Delete Color"
      End
   End
   Begin Menu M_VIEW
      Caption         =   "&View"
      Begin Menu M_VIEW_COLOR
         Caption         =   "&Color Name"
         Begin Menu M_NAME_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_NAME_PRE
            Caption         =   "&Predefined"
         End
      End
      Begin Menu M_DETAIL
         Caption         =   "Color &Detail"
         Begin Menu M_COLOR_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_COLOR_PRE
            Caption         =   "&Predefined"
         End
      End
   End
Option Explicit
Sub Form_Load ()
  Dim winDir As String
  Dim infile As Integer
  Dim inline As String
  Dim pos As Integer
  Dim listString As String
  On Error GoTo ErrorEditRgb
  ' get a list of the colors supported
  listString = Space$(10 * 1024) ' 10 K
  cbnGetColorList listString, 10 * 1024
  ' find the double 0 at the end
  pos = InStr(listString, Chr$(0) + Chr$(0))
  ' leave one of the 0s for the end of the last string
  listString = Left$(listString, pos)
  pos = InStr(listString, Chr$(0))
  While pos <> 0
    List1.AddItem Mid$(listString, 1, pos - 1)
    listString = Mid$(listString, pos + 1, Len(listString))
    pos = InStr(listString, Chr$(0))
  Wend
  listString = Space$(10 * 1024)
  cbnGetUserColorList listString, 10 * 1024
  ' find the double 0 at the end
  pos = InStr(listString, Chr$(0) + Chr$(0))
  ' leave one of the 0s for the end of the last string
  listString = Left$(listString, pos)
  pos = InStr(listString, Chr$(0))
  While pos <> 0
    List2.AddItem Mid$(listString, 1, pos - 1)
    listString = Mid$(listString, pos + 1, Len(listString))
    pos = InStr(listString, Chr$(0))
  Wend
  ' point the lists to the right place
  If List1.ListCount <> 0 Then
    List1.ListIndex = 0
    List1_DblClick
  End If
  If List2.ListCount <> 0 Then
    List2.ListIndex = 0
    List2_DblClick
  End If
ErrorEditRgb:
  Exit Sub
End Sub
Sub List1_Click ()
  List1_DblClick
End Sub
Sub List1_DblClick ()
  Dim colorName As String
  Dim Color As Long
  colorName = List1.List(List1.ListIndex)
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color
End Sub
Sub List2_Click ()
  List2_DblClick
End Sub
Sub List2_DblClick ()
  Dim colorName As String
  Dim Color As Long
  colorName = List2.List(List2.ListIndex)
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color
End Sub
Sub M_ADD_COLOR_Click ()
  Dim colorName As String
  On Error GoTo ErrorHandler
  colorName = InputBox("Enter New Color Name:", "Color Name")
  If colorName = "" Then
    Exit Sub
  End If
   If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If
   If cbnUserColorExists(colorName) = CBN_EXISTS Then
    MsgBox "Error: User Color " + colorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If
  CMDialog.CancelError = True
  CMDialog.Flags = &H2&
  CMDialog.Action = 3
  cbnAddUserColor colorName, CLng(CMDialog.Color)
  List2.BackColor = CMDialog.Color
  List2.AddItem colorName
  List2.ListIndex = List2.NewIndex
ErrorHandler:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_CHANGE_Click ()
  Dim colorName As String
  Dim Color As Long
  Dim cnt As Integer
  On Error GoTo ErrorHandler2
  colorName = InputBox("Enter Color Name To Change:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: " + colorName + " is predefined - can only change user colors", 48, "Color Name Error"
    Exit Sub
  End If
  If cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: User Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
  cbnAddUserColor colorName, CLng(CMDialog.Color)
  List2.BackColor = CMDialog.Color
  ' find colorName in the list and set the index to it
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = colorName Then
      List2.ListIndex = cnt
      Exit For
    End If
  Next
' Error handling here please
ErrorHandler2:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_COLOR_PRE_Click ()
  Dim colorName As String
  Dim Color As Long
  On Error GoTo ErrorHandlerColorPre
  colorName = InputBox("Enter Color Name To View:", "Color Name", List1.List(List1.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
ErrorHandlerColorPre:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_COLOR_USER_Click ()
  Dim colorName As String
  Dim Color As Long
  On Error GoTo ErrorHandlerColorUser
  colorName = InputBox("Enter Color Name To View:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
ErrorHandlerColorUser:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_DELETE_Click ()
  Dim colorName As String
  Dim Color As Long
  Dim cnt As Integer
  On Error GoTo ErrorHandlerDelete
  colorName = InputBox("Enter Color Name To Delete:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: " + colorName + " is predefined - can only delete user colors", 48, "Color Name Error"
    Exit Sub
  End If
  If cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: User Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  cbnDeleteUserColor colorName
  ' find colorname in the user defined list and
  ' blow it away
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = colorName Then
      List2.RemoveItem cnt
      Exit For
    End If
  Next
  List2.ListIndex = 0
  List2_Click
' Error handling here please
ErrorHandlerDelete:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_EXIT_Click ()
  End
End Sub
Sub M_NAME_PRE_Click ()
  Dim colorName As String
  Dim Color As Long
  colorName = InputBox("Enter Color Name to View:", "View Color By Name", List1.List(List1.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color
End Sub
Sub M_NAME_USER_Click ()
  Dim colorName As String
  Dim Color As Long
  colorName = InputBox("Enter Color Name to View:", "View Color By Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If
  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color
End Sub